home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / pkey12_1.zip / KY.LSP < prev    next >
Text File  |  1992-09-13  |  2KB  |  75 lines
  1. ;Add a key note to your drawing (handy)
  2. ;
  3. ;
  4. (princ "\nExample Scale Factors are:")
  5. (princ "\n1/8=96, 1/4=48, 3/8=32, 1/2=24")
  6. (defun kyerr (s)
  7. (if (/= s "Function cancelled")(princ (strcat "\nError: " s)))
  8. (setq rw *rw)
  9. (setq tg *tg)
  10. (setq kb *kb)
  11. (setvar "orthomode" OM)
  12. (setq *error* olderr)
  13. (princ))
  14. (defun dtr (angg)
  15. (* pi (/ angg 180.0)))
  16. (setq olderr *error* *error* kyerr)
  17. (if (= *rw nil)(setq *rw "A")
  18. (setq rw *rw))
  19. (if (= *tg nil)(setq *tg "S")
  20. (setq tg *tg))
  21. (if (= *kb nil)(setq *kb "R")
  22. (setq kb *kb))
  23. (if (= *scf nil)(setq *scf 96.0)
  24. (setq scf *scf))
  25. (setq OM(getvar"orthomode"))
  26. (princ "\nEnter the Scale Factor for this sheet < ")
  27. (princ *scf)
  28. (setq scf (getreal " >: "))
  29. (if (= scf nil)(setq scf *scf)(setq *scf scf))
  30. (SETQ arw(GETSTRING (STRCAT "\n(A)rch. arrow. (D)im arrow.  Do(T). < ")
  31. (PROMPT *rw)
  32. (prompt "\ >")
  33. (princ)))
  34. (if(= arw "")(setq arw *rw)(setq *rw arw))
  35. (IF(OR(= arw "A")(= arw "a"))(SETQ arw "aarw"))
  36. (IF(OR(= arw "D")(= arw "d"))(SETQ arw "darw"))
  37. (IF(OR(= arw "T")(= arw "t"))(SETQ arw "dota"))
  38. (SETQ TAG
  39. (GETSTRING(strcat"\n(H)ex. (C)ircle. (S)quare. (E)llipse.(Tr)iangle.< ")
  40. (prompt *tg)
  41. (prompt "\ >")
  42. (princ)))
  43. (if(= tag "")(setq tag *tg)(setq *tg tag))
  44. (IF(OR(= tag "H")(= tag "h"))(SETQ tag "hex"))
  45. (IF(OR(= tag "S")(= tag "s"))(SETQ tag "sqr"))
  46. (IF(OR(= tag "C")(= tag "c"))(SETQ tag "cir"))
  47. (IF(OR(= tag "E")(= tag "e"))(SETQ tag "ell"))
  48. (IF(OR(= tag "TR")(= tag "tr"))(SETQ tag "tri"))
  49. (SETQ KBLK
  50. (GETSTRING(strcat"\nKeynote (R)ight. (L)eft. (T)op. (B)ottom. < ")
  51. (prompt *kb)
  52. (prompt "\ >")
  53. (princ)))
  54. (if(= kblk "")(setq kblk *kb)(setq *kb kblk))
  55. (IF(OR(= KBLK "R")(= KBLK "r"))(SETQ KBLK (strcat tag "R")))
  56. (IF(OR(= KBLK "B")(= KBLK "b"))(SETQ KBLK (strcat tag "B")))
  57. (IF(OR(= KBLK "L")(= KBLK "l"))(SETQ KBLK (strcat tag "L")))
  58. (IF(OR(= KBLK "T")(= KBLK "t"))(SETQ KBLK (strcat tag "T")))
  59. (setq kt(getstring  T "\nEnter keynote number : "))
  60. (setq FP(getpoint "\nPick leader startpoint : "))
  61. (setvar "orthomode" 0)
  62. (setq SP(getpoint  FP "\nsecond point: "))
  63. (command "line" fp sp "")
  64. (setvar "orthomode" 1)
  65. (setq EP(getpoint  sp "\nend point: "))
  66. (IF(= EP NIL)(SETQ EP SP))
  67. (setq a1(angle fp sp))
  68. (setq a2(* a1 57.2958))
  69. (command"insert" arw fp scf "" a2)
  70. (command"line" sp ep "")
  71. (command"insert" KBLK ep SCF "" "0" kt)
  72. (setvar "orthomode" om)
  73. (setq fp nil sp nil ep nil a1 nil a2 nil arw1 nil kt nil kblk1 nil)
  74. (setq *error* olderr)
  75. (princ)